; _____ _ _ __ __ _
; / ____| | (_) \ \ / / | |
; | (___ | |_ _ __ _ _ __ __ _ \ \ /\ / /___ _ __ __| |___
; \___ \| __| '__| | '_ \ / _` | \ \/ \/ // _ \| '__/ _` / __|
; ____) | |_| | | | | | | (_| | \ /\ /| (_) | | | (_| \__ \
; |_____/ \__|_| |_|_| |_|\__, | \/ \/ \___/|_| \__,_|___/
; string related words __/ |
; |___/
; RND ( limit -- n)
; pushes a pseudo random number between 0 and limit-1 (rnd MOD limit)
; For the full range (0-65535) use a limit of 0
_rnd mov @seed,r1
li r0,>6fe5 ; multiplier
mpy r0,r1 ; mpultiply r1 by r0
ai r2,>7ab9 ; add 7ab9 to r2
src r2,5 ; rotate r2 5 bits right
mov r2,@seed
clr r1 ; msw of dividend
div *stack,r1 ; divide R1 by # on stack
mov r2,*stack ; copy remainder, R2, to stack
rndx b @retb0
; COUNT ( addr1 -- addr2 len )
; addr2 is addr1+1 and len is the length of the counted string at addr1.
; The byte at addr1 contains the byte count len. Range of len is {0.255}
_count mov *stack,r0 ; get addr1
movb *r0,r7 ; get length byte from addr1
srl r7,8 ; move to low byte
inc *stack ; increment addr1 to make addr2
PAE dect stack ; make space on stack
mov r7,*stack ; push length
jmp rndx
; -TRAILING ( addr len -- addr len )
; modifies len such that trailing spaces are excluded from the string
_trail mov *stack,*stack ; check length
jeq trlout ; if 0 then exit
jlt trlout ; if negative then exit
mov @2(stack),r0 ; address
a *stack,r0 ; move to end of string+1
dec r0 ; correct to point to last character
trail2 cb *r0,@_space ; compare to a space
jeq trail1 ; if a space, reduce length
trlout jmp rndx ; else exit
trail1 dec *stack ; reduce length
jeq rndx ; if we get to 0 then exit
dec r0 ; else check next address
jmp trail2
; S" Compile time:( -- ) Immediate:( -- address length )
; When Compiling:
; compiles: (S")
; e.g S" HELLO" compiles (S") 5 H E L L O
; At the end of string compilation, HERE is aligned to an even address.
; At run time, (S") (see below) pushes the address of the beginning of
; the string and the length to the stack.
;
; When Interpreting:
; Compiles the string to the address PAD, as above, and pushes the address and
; length to the stack.
_strin mov @_state,r0 ; check state
jne _stri1 ; jump if compiling
; not compiling, move string to PAD and adjust address
mov *stack+,r0 ; get pad address
mov r0,r6 ; copy it
mov *stack,r2 ; get length
mov @2(stack),r1 ; get source address
strc1 movb *r1+,*r0+ ; copy to pad
dec r2
jne strc1
mov r6,@2(stack) ; put PAD address in place of original
; address
jmp rndx
; compiling. compile (S")
_stri1 mov *stack+,r0 ; discard pad address on stack
mov @here,r0 ; compilation address
li r1,str ; CFA of (S")
mov r1,*r0+ ' compile (S")
mov *stack+,r2 ; get length
swpb r2 ; move to high byte
movb r2,*r0+ ; compile length byte
swpb r2 ; restore length
mov *stack+,r1 ; address of string in cpu memory
_stri2 movb *r1+,*r0+ ; copy string to definition
dec r2 ; finished?
jne _stri2
inc r0 ; round up HERE
andi r0,>fffe ; mask off LSB
mov r0,@here ; store it
b @mpadj ; adjust memory pointers and exit via mpadj
; (S") ( -- cpu_addr len )
; pushes the address and length of the string (compiled by S") onto the stack
; On entry, PC is actually pointing at the length byte. The address of the
; string is actually the address of the length byte+1. The length is just the
; value of the length byte. PC is adjusted to resume execution at the first even
; cell following the string.
_str movb *pc+,r0 ; get length
dect stack ; make space on stack
mov pc,*stack ; move address of string to stack
dect stack ; make space on stack
srl r0,8 ; place length in low byte
mov r0,*stack ; place length on stack
a r0,pc ; advance program counter
ai pc,1 ; round up PC...
andi pc,>fffe ; ...to an even value
b @retB0
; NUMBER TO STRING ( num -- addr len )
; Takes a number off the stack and converts it to a signed string equivalent,
; with respect to the current number base. Number base may be between
; 2 and 36. The routine checks location DOSIGN, and if 0, the
; number is treated as signed, else its unsigned. The routine also checks
; location LZI, and, if zero, leading zero's will be supressed.
; This is quite a bitch of a routine. Since any number base (between 2 and 36)
; can be employed this routine is rather complex. The routine must first
; determine the appropriate powers of the number base so we can divide the
; target number later. Obviously this is expensive, so the routine remembers
; what the active number base was the last time it was called, and ONLY
; re-computes the exponents if the base has changed since the last time it was
; called.
; This first part computes the column values.
; So, if the base is 10, you end up with 1,10,100,1000,10000
_nts mov rstack,r14 ; save rstack 'cos we're using it
mov *stack,r9 ; get number off stack
li r7,2 ; exponent counter (base^0 and base^1 are
; easy to compute ;-)
; used as a word offset into workbuffer so
; counts in multiples of 2.
c @base,@lbase ; check if base has chaged since the last
; time we were called
jeq dodiv ; base hasn't changed, no need to compute
; powers of the base.
mov @base,@lbase ; base has changed, store it in 'last base'
li r0,1 ; base^0 is always 1 - easy ;-)
li r1,wrkbuf ; place to store the powers of our base
; determine base^x until result > 65535
mov r0,*r1+ ; store base^0 and move forward in buffer
mov @base,*r1 ; base^1 is always base ;-) store it
pwr mov *r1+,r5 ; get previous exponent
mpy @base,r5 ; multiply it by base - lower 16 bit result
; in r6
mov r5,r5 ; see if the result overflowed into upper
; 16 bits
jne pwrout ; there was an overflow, exit loop
mov r6,*r1 ; otherwise store result
inct r7 ; and increment exponent counter
jmp pwr ; and repeat
; Ok we have computed the 'column values' (powers) for our base. Now we
; sucessively divide the number down until nothing is left, building
; the string equivalent as we compute each digit. Just to make life
; harder for ourselves, we will optionally allow leading zero's to be
; supressed. If the word at LZI<>0 then leading zero's are suppressed.
pwrout mov r7,@expcnt ; save exponent count for next time routine
; is run
dodiv mov @expcnt,r7 ; entry point when exponents arent computed.
; restore exponent count
li r0,strbuf ; address of string buffer where we build
; the string
clr r1 ; buffer length counter
mov @dosign,r8 ; check if producing an unsigned number
jne ninn ; skip if we are
mov r9,r8 ; else, check if number is negative and if
; so, add "-" character
andi r8,>8000 ; is it negative
jeq ninn ; its not negative, jump
li r8,'-'*256 ; the number is negative, add a minus sign
; to the string buffer
movb r8,*r0+ ; place it in the buffer
inc r1 ; increment length counter
neg r9 ; change the number to positive
ninn clr r8 ; div instruction uses 32 bit dividend, our
; 16 bit argument is in r9
mov @lzi,r10 ; leading zero indicator 0=suppress
nxtdig div @wrkbuf(r7),r8 ; divide our number by exponent value.
; result=r8, remainder=r9
mov r8,r8 ; was the result 0?
jeq testlz ; if yes then check if ignoring leading
; zeros
seto r10 ; not zero, so reset leading zero indicator
dodig movb @tlut(r8),*r0+ ; lookup digit value, move it to string
; buffer and advance buffer address
clr r8 ; clear result for next interation
inc r1 ; increment length counter
iglz dect r7 ; done all our columns/exponents?
jne nxtdig ; loop if not
movb @tlut(r9),*r0+ ; lookup digit value, move it to string
; buffer and advance buffer address
; we've done our division, push address & length to the stack and exit
li r0,strbuf ; address of string buffer
mov r0,*stack ; move address to stack
dect stack ; new stack entry
inc r1